macro 'Plot Histogram'; var max,scale:real; i,margin,width,height:integer; begin SaveState; Margin:=10; width:=256; height:=0.6*256; Measure; SetForegroundColor(255); SetBackgroundColor(0); SetLineWidth(1); SetNewSize(width+2*margin,height+2*margin); MakeNewWindow('Histogram'); MakeRoi(margin,margin-1,width,height+1); DrawBoundary; max:=0; for i:=1 to 254 do if histogram[i]> max then max:=histogram[i]; scale:=height/max; for i:=1 to 254 do begin MakeRoi(margin+i,margin,1,histogram[i]*scale); SetForegroundColor(i); fill; end; SelectAll; FlipVertical; KillRoi; RestoreState; end; macro 'Stack Histogram'; var max,scale:real; i,margin,width,height:integer; begin SaveState; Margin:=10; width:=256; height:=0.6*256; Measure; SetForegroundColor(255); SetBackgroundColor(0); SetLineWidth(1); SetNewSize(width+2*margin,height+2*margin); MakeNewWindow('Histogram'); MakeRoi(margin,margin-1,width,height+1); DrawBoundary; max:=0; for i:=1 to 254 do if histogram[i]> max then max:=histogram[i]; scale:=height/max; for i:=1 to 254 do begin MakeRoi(margin+i,margin,1,histogram[i]*scale); SetForegroundColor(i); fill; end; SelectAll; FlipVertical; KillRoi; RestoreState; end; procedure DoColumnPlot(MaxCount: integer); {Plots the User1 column in the Results table.} var xmin,xmax,ymin,ymax,i,xscale,yscale:real; width,height,margin,pwidth,pheight:integer; y,pbottom, barWidth, barLeft, barTop:integer; sum:integer; begin SaveState; margin:=40; width:=500; height:=300; sum:=0; ymin:=0; ymax:=-999999; for i:=1 to maxCount do if rUser1[i]>ymax then ymax:=rUser1[i]; xmin:=1; xmax:=maxCount; SetNewSize(width,height); SetForeground(255); SetBackground(0); MakeNewWindow('Histogram'); pwidth:=width-2*margin; pheight:=height-2*margin; pbottom:=margin+pheight; xscale:=pwidth/xmax; yscale:=pheight/(ymax-ymin); barWidth:=round(pwidth/maxCount)+1; SetForeground(255); SetBackground(0); SetLineWidth(1); for i:=0 to maxCount-1 do begin barLeft:=margin+i*xscale; barTop:=pbottom-(rUser1[i+1]-ymin)*yscale; MakeRoi(barLeft, barTop, barWidth, pBottom-barTop); fill; sum:=sum+(i+1)*rUser1[i+1]; end; KillRoi; MoveTo(margin,margin); LineTo(margin,margin+pheight); SetFont('Geneva'); SetFontSize(9); SetText('Centered'); MoveTo(margin+4,margin+pheight+12); writeln(xmin:1:2); MoveTo(margin+pwidth,margin+pheight+12); writeln(xmax:1:2); SetText('Right Justified'); MoveTo(margin-2,margin+pheight-5); writeln(ymin:1:2); MoveTo(margin-2,margin); writeln(ymax:1:2); MoveTo(margin+pwidth/2-15, margin+pheight+12); RestoreState; ShowMessage('sum=',sum:1,'\ymax=',ymax:1); end; macro 'Plot Histogram Using Bins'; var i, nBins, bin: integer; ValuesPerBin, TotalArea: real; n, lower, upper, nValues: integer; first, last: integer; begin ResetCounter; nBins:=GetNumber('Number of Bins (1-256)', 10); SetUser1Label('%'); SetUser2Label('Area'); Measure; TotalArea := rArea[rCount]; GetThreshold(lower, upper); if (lower = 0) and (upper = 0) then upper := 255; nValues := upper - lower + 1; n := 0; for i := lower to upper do n := n + histogram[i]; ValuesPerBin := nValues / nBins; for bin := 1 to nBins do rUser1[bin] := 0; {for i := lower to upper do begin bin := trunc((i - lower) / ValuesPerBin) + 1; rUser1[bin] := rUser1[bin] + Histogram[i]; end;} SaveState; SetFont('Monaco'); SetFontSize(9); NewTextWindow('Histogram Data', 280, 450); writeln(' Bin Range Count Percent Area'); for bin := 1 to nBins do begin first := lower + trunc((nValues * (bin - 1)) / nBins); last := lower + trunc((nValues * bin) / nBins) -1 ; for i := first to last do rUser1[bin] := rUser1[bin] + Histogram[i]; writeln(bin:3, first:6, last:4, rUser1[bin]:8, (rUser1[bin] / n) * 100:8:2, TotalArea * rUser1[bin] / n:10:2); end; RestoreState; for bin := 1 to nBins do rUser1[bin] := (rUser1[bin] / n) * 100.0; for bin := 1 to nBins do rUser2[bin] := TotalArea * rUser1[bin] / 100; SetCounter(nBins); DoColumnPlot(nBins); end; procedure DrawPerimeter; var length1, length2: integer; dx1, dx2, dy1, dy2: integer; dxp1, dxp2, dyp1, dyp2: integer; sumdx, sumdy, corners: integer; corner: boolean; perimeter: real; begin RedLUT[254] := 255; GreenLUT[254] := 0; BlueLUT[254] := 0; SetForeground(254); sumdx := 0.0; sumdy := 0.0; corners := 0; dx1 := xCoordinates[1] - xCoordinates[nCoordinates]; dy1 := yCoordinates[1] - yCoordinates[nCoordinates]; length1 := abs(dx1) + abs(dy1); dxp1 := dx1; if dxp1 > 1 then dxp1 := 1; if dxp1 < -1 then dxp1 := -1; dyp1 := dy1; if dyp1 > 1 then dyp1 := 1; if dyp1 < -1 then dyp1 := -1; corner := false; for i := 1 to nCoordinates do begin dx2 := xCoordinates[i+1] - xCoordinates[i]; dy2 := yCoordinates[i+1] - yCoordinates[i]; {showmessage(i, abs(dx1), abs(dy1)); wait(2);} sumdx := sumdx + abs(dx1); sumdy := sumdy + abs(dy1); length2 := abs(dx2) + abs(dy2); dxp2 := dx2; if dxp2 > 1 then dxp2 := 1; if dxp2 < -1 then dxp2 := -1; dyp2 := dy2; if dyp2 > 1 then dyp2 := 1; if dyp2 < -1 then dyp2 := -1; if (length1 > 1) or (not corner) then begin MoveTo((xCoordinates[i]-dxp1)*scale+10, (yCoordinates[i]-dyp1)*scale+10); LineTo((xCoordinates[i]+dxp2)*scale+10, (yCoordinates[i]+dyp2)*scale+10); corner := true; corners := corners + 1; end else corner := false; dx1 := dx2; dy1 := dy2; dxp1 := dxp2; dyp1 := dyp2; length1 := length2; end; perimeter := sumdx + sumdy; end; procedure ShowPerimeter; var length1, length2: integer; dx1, dx2, dy1, dy2: integer; sumdx, sumdy, nCorners: integer; corner: boolean; perimeter: real; begin sumdx := 0.0; sumdy := 0.0; nCorners := 0; dx1 := xCoordinates[1] - xCoordinates[nCoordinates]; dy1 := yCoordinates[1] - yCoordinates[nCoordinates]; length1 := abs(dx1) + abs(dy1); corner := false; for i := 1 to nCoordinates do begin dx2 := xCoordinates[i+1] - xCoordinates[i]; dy2 := yCoordinates[i+1] - yCoordinates[i]; sumdx := sumdx + abs(dx1); sumdy := sumdy + abs(dy1); length2 := abs(dx2) + abs(dy2); if (length1 > 1) or (not corner) then begin corner := true; nCorners := nCorners + 1; end else corner := false; dx1 := dx2; dy1 := dy2; length1 := length2; end; perimeter := sumdx + sumdy; MoveTo(width/3,height/3 + 40); Writeln('perimeter1=', perimeter:1:2); Writeln('perimeter2=', perimeter - nCorners * (2 - sqrt(2)):1:2); Writeln('perimeter3=', perimeter*0.948 - nCorners * (2 - 1.34):1:2); end; procedure DrawX(x, y:integer); begin moveto(x+3, y+3); lineto(x-3, y-3); moveto(x+3, y-3); lineto(x-3, y+3); lineto(x, y); end; macro 'Plot XY Coordinates [X]'; {Plots the X-Y Coordinates of the current ROI.} var i,w,h,width,height:integer; xbase,ybase,RoiWidth,RoiHeight:integer x,y,scale,xmax,ymax:real begin RequiresVersion(1.48); if nCoordinates=0 then begin beep; PutMessage('No X-Y Coordinates available.'); exit; end; GetRoi(xbase,ybase,RoiWidth,RoiHeight); SaveState; InvertY(false); xmax:=0; ymax:=0; for i:=1 to nCoordinates do begin x:=xCoordinates[i]; y:=yCoordinates[i]; if x>xmax then xmax:=x; if y>ymax then ymax:=y; end; scale:=sqrt((300*300)/(xmax*ymax)); if (xmax*scale)>500 then scale:=500/xmax; if (ymax*scale)>500 then scale:=500/ymax; SetForegroundColor(255); SetBackgroundColor(0); SetNewSize(xmax*scale+20,ymax*scale+20); MakeNewWindow('Outline'); MoveTo(xCoordinates[1]*scale+10,yCoordinates[1]*scale+10); for i:=2 to nCoordinates do begin LineTo(xCoordinates[i]*scale+10,yCoordinates[i]*scale+10); if nCoordinates < 100 then DrawX(xCoordinates[i]*scale+10,yCoordinates[i]*scale+10); end; SetFont('Helvetica'); SetFontSize(12); SetText('No background, Left Justified'); GetPicSize(width,height); MoveTo(width/3,height/3); Writeln(nCoordinates:1,' coordinate pairs'); Writeln('Origin=',xbase:1,', ',ybase:1); Writeln('xmax=',xmax:1, ', ymax=',ymax:1,); {DrawPerimeter;} {ShowPerimeter;} RestoreState; end; procedure PlotProfile2(integrate:boolean); var xmin,xmax,ymin,ymax,i,xscale,yscale:real; width,height,margin,pwidth,pheight:integer; count:integer; ppv:integer; {Pixels per Value} begin SaveState; margin:=40; width:=500; height:=300; GetPlotData(count,ppv,ymin,ymax); if count=0 then begin PutMessage('No plot data available.'); exit; end; if integrate then begin ymin:=ymin*ppv; ymax:=ymax*ppv; end; xmin:=0; xmax:=count-1; SetNewSize(width,height); SetForeground(255); SetBackground(0); MakeNewWindow('Plot'); pwidth:=width-2*margin; pheight:=height-2*margin; xscale:=pwidth/(xmax-xmin); yscale:=pheight/(ymax-ymin); SetForeground(255); SetBackground(0); SetLineWidth(1); MoveTo(margin,margin); if integrate then for i:=0 to count-1 do LineTo(margin+i*xscale,margin+(PlotData[i]*ppv-ymin)*yscale) else for i:=0 to count-1 do LineTo(margin+i*xscale,margin+(PlotData[i]-ymin)*yscale); MakeRoi(margin,margin,pwidth+1,pheight+2); MoveTo(margin,margin); LineTo(margin+pwidth,margin); MoveTo(margin,margin); LineTo(margin,margin+pheight); FlipVertical; KillRoi; SetFont('Geneva'); SetFontSize(9); SetText('Centered'); MoveTo(margin+4,margin+pheight+12); writeln(xmin:1:2); MoveTo(margin+pwidth,margin+pheight+12); writeln(xmax:1:2); SetText('Right Justified'); MoveTo(margin-2,margin+pheight-5); writeln(ymin:1:2); MoveTo(margin-2,margin); writeln(ymax:1:2); RestoreState; end; macro 'Plot Profile'; begin PlotProfile2(false); end; macro 'Plot Integrated Profile'; begin PlotProfile2(true); end; macro 'Plot Radial ProfilesÉ [R]'; var x1,y1,x2,y2,pi,angle,delta:real; LineWidth,i,nLines,radius,PlotWidth,PlotHeight:integer; MinPlotWidth,hMargin,vMargin,PlotLeft,PlotTop:integer; LeftMargin,RightMargin,TopMargin,BottomMargin:integer; ImageWindow,PlotWindow:integer; nPixels,mean,mode,min,max:real; begin RequiresVersion(1.54); SaveState; GetLine(x1,y1,x2,y2,LineWidth); if x1<0 then begin PutMessage('Please select a point by clicking with the line tool.'); exit; end; radius:=GetNumber('Radius:',20); nLines:=GetNumber('Number of Lines:',8); MinPlotWidth:=140; pi:=3.14159; delta:=2.0*pi/nLines; angle:=0.0; PlotWidth:=radius; if PlotWidth255 then max:=255; SetPlotScale(cValue(min),cValue(max)); SetPlotLabels(false); hMargin:=5; vMargin:=5; LeftMargin:=38; TopMargin:=10; RightMargin:=20; BottomMargin:=20; PlotLeft:=hMargin-LeftMargin; PlotTop:=vMargin-TopMargin; SetNewSize(PlotWidth+2*hMargin,PlotHeight*nLines); SetForegroundColor(255); SetBackgroundColor(0); ImageWindow:=PicNumber; MakeNewWindow('Plots'); PlotWindow:=PicNumber; SelectPic(ImageWindow); for i:=1 TO nLines do begin x2:=x1+round(radius*cos(angle)); y2:=y1+round(radius*sin(angle)); MakeLineRoi(x1,y1,x2,y2); PlotProfile; Copy; SelectPic(PlotWindow); MakeRoi(PlotLeft,PlotTop,PlotWidth+LeftMargin+RightMargin, PlotHeight+TopMargin+BottomMargin); Paste; DoOr; PlotTop:=PlotTop+PlotHeight-1; SelectPic(ImageWindow); angle:=angle+delta; end; RestoreState; end; macro 'Radial Intensity DistibutionÉ'; var x1,y1,x2,y2,pi,angle,delta:real; radius,ymin,ymax,sum:real; i,j,LineWidth,nLines,count,ppv:integer; begin RequiresVersion(1.54); SaveState; GetLine(x1,y1,x2,y2,LineWidth); if x1<0 then begin PutMessage('Please select a point by clicking with the line tool.'); exit; end; radius:=GetNumber('Radius (pixels):',50); nLines:=GetNumber('Number of Lines:',25); for i:= 1 to radius do rUser1[i]:=0; pi:=3.14159; delta:=2.0*pi/nLines; angle:=0.0; for i:=1 to nLines do begin x2:=x1+round(radius*cos(angle)); y2:=y1+round(radius*sin(angle)); MakeLineRoi(x1,y1,x2,y2); GetPlotData(count,ppv,ymin,ymax); for j:=1 to count do rUser1[j]:=rUser1[j]+PlotData[j]; angle:=angle+delta; end; RestoreState; DoColumnPlot(radius); end; macro 'Circular Profile Plot [C]'; var radius,pi,angle,dx,dy,delta:real; x1,y1,x2,y2:real; npoints,i,value,LineWidth,x,y,px:integer; begin GetLine(x1,y1,x2,y2,LineWidth); if x1< 0 then begin PutMessage('Please select a point by clicking with the line tool.'); exit; end; x:=x1+(x2-x1)/2; y:=y1+(y2-y1)/2; radius:=sqrt(sqr(x2-x1)+sqr(y2-y1))/2; if radius<3 then begin PutMessage('The line selection must be longer than 5 pixels.'); exit; end; npoints:=radius*2; pi:=3.14159; delta:=2.0*pi/npoints; angle:=0.0; px:=0; for i:=1 TO npoints do begin dx:=round(radius*cos(angle)); dy:=round(radius*sin(angle)); value:=GetPixel(x+dx,y+dy); PutPixel(x+dx,y+dy,255); PutPixel(px,0,value); px:=px+1; angle:=angle+delta; end; MakeLineRoi(0,0,npoints,0); PlotProfile; KillRoi; end; macro 'Export Profile PlotsÉ'; var y,yInc,width,height,n:integer; begin yInc:=GetNumber('Y Increment:',10); GetPicSize(width,height); y:=0; n:=0; SetExport('Plot Values'); repeat MakeLineRoi(0,y,width-1,y); PlotProfile; Export('PLOT',n:4); n:=n+1; y:=y+yInc; until y>=height; end; procedure PlotMeans; {Plots the mean column in the Results table.} var xmin,xmax,ymin,ymax,i,xscale,yscale:real; width,height,margin,pwidth,pheight:integer; y,pbottom:integer; begin margin:=40; width:=500; height:=300; ymax:=-999999; ymin:=999999; for i:=1 to rCount do begin y:=rMean[i]; if y>ymax then ymax:=y; if yheight then begin PutMessage('Selection must be vertically oriented.'); exit; end; nLabels:=round(height/25); if nLabels<2 then nLabels:=2; SetFontSize(9); SetFont('Monaco'); SetText('Left Justified, With Background'); DrawScale; {FlipVertical;} KillRoi; SetForeground(255); {black} SetBackground(0); {white} if calibrated then begin fwidth:=7; digits:=4; end else begin fwidth:=3; digits:=0; end; vloc:=top; for i:=0 to nLabels-1 do begin vloc:=top+round(i*((height-1)/(nLabels-1))); if vloc>=(top+height) then vloc:=top+height-1; MoveTo(left+width+4,vloc+3); value:=cvalue(GetPixel(left,vloc)); Write(value:fwidth:digits); vloc:=vloc+round(height/(nLabels-1)); end; RestoreRoi; SetForeground(0); {white} InsetRoi(-1); DrawBoundary; KillRoi; RestoreState; end; macro 'Show Polar Coordiates [P]'; {Returns polar coordinates of a point selected with the mouse, using centre of the image as 0,0. Data are displayed in the Info window as distance from centre of image, and angle in degrees measured clockwise, where 0 is the 12 o'clock position} var Wide, High,x2,y2:integer; x1,y1,D,Theta,rad:real; begin rad:=180/3.14159265; InvertY(true); GetPicSize(Wide,High); SetCursor('cross'); repeat GetMouse(x2,y2); x1:=Wide/2; y1:=High/2; y2:=High-y2 if (x1=x2) and (y1=y2) then begin D:=0; Theta:=0; end; if (y1<>y2) then begin D:= sqrt((sqr(x2-x1))+ (sqr(y2-y1))); Theta:=rad*(arctan((x2-x1)/(y2-y1))); end; if (y2y1) then begin Theta:=360+Theta; end; ShowMessage('Distance: ',D:5:1'\''Angle: ',Theta:5:1); Wait(0.2); until button; end; macro 'Record XY [X]'; {Records the X-Y Coordinates of each pixel in the perimeter of a particle (selected with the wand) and saves the data to a comma-delimited text file} var i,w,h:real; xbase,ybase,width,height,RoiWidth,RoiHeight:real x,y,xmax,ymax:real begin GetPicSize(width,height); GetRoi(xbase,ybase,RoiWidth,RoiHeight); if (RoiWidth=0) or (nCoordinates=0) then begin PutMessage('Select a particle with the wand.'); exit; end; InvertY(false); NewTextWindow('XY Data',150,400); for i:=1 to nCoordinates do Writeln(i,',',xCoordinates[i]+xbase:5:0,',',Height-yCoordinates[i]-ybase:5:0); end; procedure WriteReal(r:real); {Writes a real number using scientific notation.} var e: integer; begin e := 0; while r >= 10 do begin r := r / 10; e := e + 1; end; while r < 1 do begin r := r * 10; e := e - 1; end; write(r:8:6); if e >= 0 then write('e+') else begin e := -e; write('e-') end; if e <10 then write('0'); write(e:1); end; macro 'Write Real Test...'; var r: real; begin r := GetNumber('Enter a real number:', 1.234); NewTextWindow('Output'); WriteReal(r); end;